home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / others / ngz.zip / NGZ.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-14  |  20KB  |  580 lines
  1. {$define noDEBUG}
  2. {$ifdef DEBUG}
  3.    {$R+,S+}
  4. {$else}
  5.    {$R-,S-}
  6. {$endif}
  7. {$M 2048,0,655360}
  8.  
  9. PROGRAM NGZ;    { Disassemble Norton Guide database files  }
  10.                 {                                          }
  11.                 { Usage: NGZ ngfile.ng [/?][/R|/Poffs[/Q]] }
  12.                 {                                          }
  13.                 { Contains detailed description of the NG  }
  14.                 { v1.0 database file format.               }
  15.                 {                                          }
  16.                 { Morten Elling - May, 1993                }
  17. USES Dos;
  18.  
  19. {$I ngz.glo }   { Global definitions }
  20. {$I ngz.inc }   { Support routines   }
  21. {   ngz.doc }   { Documentation file }
  22. { Compile with Turbo Pascal 4.0+     }
  23.  
  24. { -------------------------------------------------------------------------- }
  25.  
  26.  
  27. PROCEDURE list_pointers(VAR f : TEXT); FORWARD;
  28.  
  29. PROCEDURE exZit(rc : BYTE);
  30.    PROCEDURE write_usage;
  31.    BEGIN  WRITELN('Usage: NGZ ngfile.ng [/?][/R | /Poffset[/Q]]');  END;
  32. BEGIN
  33.    IF (rc = 0) OR (rc >=5) THEN BEGIN
  34.       CLOSE(NGf);
  35.       CLOSE(screen);
  36.    END;
  37.    IF NOT is_partial AND (rc IN [8,12]) THEN BEGIN
  38.       list_pointers(reptf);
  39.       CLOSE(reptf);
  40.    END;
  41.  
  42.    CASE rc OF
  43.       0 : WRITELN('Done.');
  44.       1 : BEGIN
  45.           WRITELN('NGZ 1.0 ■ Disassemble NG database files ■ /Me 1993');
  46.           write_usage;
  47.           WRITELN('  /?  This text');
  48.           WRITELN('  /R  Report only (',dot_RPT,')');
  49.           WRITELN('  /Poffset  Partial disassembly at _hex_ file offset.');
  50.           WRITELN('      Run a report first to get the offset.');
  51.           WRITELN('      Don''t use this on menu or short-to-short strucs.');
  52.           WRITELN('  /Q  Suppress screen output (Note: disables Ctrl-C)');
  53.           WRITELN;
  54.           rc := 0;
  55.           END;
  56.       2 : write_usage;
  57.       4 : WRITELN('Error on input.');
  58.       5 : WRITELN('Not a valid NG database file.');
  59.       8 : WRITELN('Unexpected Eof.');
  60.       9 : WRITELN('Bad menu structure.');
  61.      12 : WRITELN('Unknown structure ID (',last_ID,').');
  62.      13 : WRITELN('Bad seek.');
  63.    END;
  64.    IF rc > 2 THEN WRITELN('Aborted.');
  65.  
  66.    HALT(rc);    { Exit to DOS setting errorlevel }
  67. END;
  68.  
  69.  
  70. FUNCTION GetNGstr(i : WORD; VAR sz : WORD) : str100;
  71. { Get NG-compressed ASCIIZ string, starting at buf[i],
  72.   expanding spaces, and returning (compressed) length
  73.   (less trailing zero) in var sz }
  74. VAR
  75.    j, k, z : WORD;  st : str100;
  76. BEGIN
  77.    j := 0;  z := i;
  78.    WHILE (buf[i] > 0) AND (j < one_hundred) DO BEGIN
  79.       Inc(j);
  80.       IF (buf[i] = 255) AND (buf[i+1] > 0) THEN BEGIN
  81.          FOR k := 1 TO buf[i+1] DO
  82.             IF j < one_hundred THEN BEGIN    { prevent overflow }
  83.                st[j] := #32;
  84.                Inc(j);
  85.             END;
  86.          Dec(j);  Inc(i);
  87.       END
  88.       ELSE st[j] := Chr(buf[i]);
  89.       Inc(i);
  90.    END;
  91.    st[0] := Chr(j);
  92.    sz := i - z;
  93.    GetNGstr := st;
  94. END;
  95.  
  96.  
  97. FUNCTION GetNGstr_s(i : WORD; VAR sz : WORD) : str100;
  98. { Get NG-compressed ASCIIZ string, starting at sbuf[i],
  99.   expanding spaces, and returning (compressed) length
  100.   (less trailing zero) in var sz }
  101. VAR
  102.    j, k, z : WORD;  st : str100;
  103. BEGIN
  104.    j := 0;  z := i;
  105.    WHILE (sbuf[i] > 0) AND (j < one_hundred) DO BEGIN
  106.       Inc(j);
  107.       IF (sbuf[i] = 255) AND (sbuf[i+1] > 0) THEN BEGIN
  108.          FOR k := 1 TO sbuf[i+1] DO
  109.             IF j < one_hundred THEN BEGIN
  110.                st[j] := #32;
  111.                Inc(j);
  112.             END;
  113.          Dec(j);  Inc(i);
  114.       END
  115.       ELSE st[j] := Chr(sbuf[i]);
  116.       Inc(i);
  117.    END;
  118.    st[0] := Chr(j);
  119.    sz := i - z;
  120.    GetNGstr_s := st;
  121. END;
  122.  
  123.  
  124. PROCEDURE read_n_verify_header;
  125. { Read NG database file header, and get database name and credits text }
  126. VAR i : WORD;  st : str2;
  127. BEGIN
  128.    buf[0] := Ord('N') XOR Ord('G');             { so no false match }
  129.    BlockRead(NGf, buf, header_size);
  130.    Move(buf[0], st[1], 2);
  131.    st[0] := #2;
  132.    IF st <> NG_file_signature THEN exZit(5);    { bad signature }
  133.  
  134.    no_of_menus := getW(6);
  135.    NG_name := getstr(8);
  136.    FOR i := 0 TO Pred(credits_num) DO
  137.       credits[i] := getstr(48 + i * Succ(credits_str_len));
  138. END;
  139.  
  140.  
  141. PROCEDURE read_n_decrypt_struc(VAR ID : WORD; varia_too : BOOLEAN);
  142. { Read structure at current file pos. into var buf and decrypt it;
  143.   file ptr is advanced to start of next structure or to Eof.
  144.   NOTE: Some NGs are zero-filled at eof to a 128 byte boundary; in this case,
  145.         the procedure does not abort but returns (at Eof) with an ID of 99
  146.         Note2: Zome wize guyz remove the last two bytes of the .NG to
  147.                prevent a disassembly; ngz can handle this }
  148. VAR i,j,k : WORD;
  149.  
  150.    FUNCTION just_zeros(a,z:WORD) : BOOLEAN;
  151.    BEGIN WHILE (buf[a] = 0) AND (a < z) DO Inc(a);
  152.          IF buf[a] <> 0 THEN just_zeros := FALSE
  153.          ELSE BEGIN Seek(NGf,FileSize(NGf)); just_zeros := TRUE; END;
  154.    END;
  155. BEGIN
  156.    IF Eof(NGf) THEN EXIT;
  157.    last_read_pos := FilePos(NGf);
  158.    BlockRead(NGf, buf[0], fixed_struc_size, j);
  159.    FOR i := 0 TO Pred(j) DO
  160.       buf[i] := buf[i] XOR crypto;              { decrypt }
  161.    IF (j <> fixed_struc_size) OR (getW(2)=0) THEN { read less than requested }
  162.       IF NOT just_zeros(0, Pred(j))
  163.          THEN exZit(8)                          { unexpected Eof }
  164.          ELSE BEGIN ID := 99; EXIT; END;        { expected Eof }
  165.    ID := getW(0);
  166.    IF ID > menu_ID THEN EXIT;                   { unknown ID }
  167.    varia_struc_size := getW(2);
  168.    IF NOT varia_too THEN BEGIN
  169.       Seek(NGf,last_read_pos + $1A + varia_struc_size);
  170.       EXIT;           { no need to read more during initial indexing }
  171.    END;
  172.    BlockRead(NGf, buf[fixed_struc_size], varia_struc_size, j);
  173.    k := Pred(fixed_struc_size + j);
  174.    FOR i := fixed_struc_size TO k DO
  175.       buf[i] := buf[i] XOR crypto;              { decrypt }
  176.    IF (j <> varia_struc_size) THEN
  177.       IF just_zeros(fixed_struc_size, k)
  178.          THEN BEGIN ID := 99; EXIT; END         { expected Eof }
  179.          ELSE IF varia_struc_size - j <= 2      { make asciiz if 2 bytes miss}
  180.          THEN BEGIN buf[$1A+j] := 0; EXIT; END
  181.          ELSE exZit(8);                         { unexpected Eof }
  182. END;
  183.  
  184.  
  185. PROCEDURE get_menu_struc;
  186. { Get info for one menu struc from var buf }
  187. VAR i,j,it,len : WORD;
  188. BEGIN
  189.    it := getW(4);    { no. of items includes menu title }
  190.    menu[curr_menu].items := it - 1;
  191.    menu[curr_menu].toptxt := getNGstr($1A + 4 * Pred(it) + 8 * it, len);
  192.  
  193.    { get file pointers and text for each menu item }
  194.    FOR i := 0 TO Pred(it) -1 DO
  195.       BEGIN
  196.          menu[curr_menu].drop[i].fptr := getDW($1A + 4 * i);
  197.          { get pointer to menu item string }
  198.          j := getW($1A + 4 * Pred(it) + 8 * i);
  199.          menu[curr_menu].drop[i].txt := getNGstr($1A + j, len);
  200.       END;
  201. END;
  202.  
  203.  
  204. PROCEDURE register_strucs;
  205. { Read NG file sequentially to build pointer list of all short strucs
  206.   and long strucs off menu, in order to resolve S/A and !File references }
  207. VAR i,cnt : WORD;  par_dw : DWORD;
  208. BEGIN
  209.    {$I-}  Seek(NGf, menu[0].drop[0].fptr);  {$I+}      { start after menus }
  210.    IF IOresult <> 0 THEN exZit(13);     { bad seek }
  211.    WRITELN(screen,'Indexing');
  212.    cnt := 0;
  213.    REPEAT
  214.       read_n_decrypt_struc(last_ID, False);  { False= read fixed part only }
  215.       CASE last_ID of                   { statistics }
  216.          short_ID: Inc(no_of_shorts);
  217.          long_ID : Inc(no_of_longs);
  218.       END;
  219.       IF last_ID = 99 THEN EXIT         { Eof: see note at read_n_decrypt }
  220.       ELSE IF last_ID = menu_ID         { in trouble, if menu reached here }
  221.          THEN exZit(9)
  222.       ELSE IF NOT (last_ID IN [short_ID, long_ID])
  223.          THEN exZit(12);                { abort if unknown ID }
  224.  
  225.       par_dw := getDW($0A);
  226.       IF (last_ID=short_ID) OR ((last_ID=long_ID) AND (par_dw = -1)) THEN
  227.       BEGIN
  228.          { register short strucs and no-parent longs in pointer list;
  229.            these go in separate files }
  230.          Inc(out_files_num);
  231.          src^.ID        := last_ID;
  232.          src^.file_offs := last_read_pos;
  233.          src^.par_ptr   := par_dw;
  234.          IF last_ID = long_ID
  235.             THEN src^.first_ptr := last_read_pos
  236.             ELSE src^.first_ptr := -1;  { don't know yet }
  237.          src^.last_ptr  := src^.first_ptr;
  238.          src^.tgt_file  := out_files_num;
  239.          src^.next      := NIL;   { assume end of list }
  240.          { }
  241.          IF src <> sr1 THEN
  242.             srp^.next   := src;   { link previous rec to this }
  243.          srp            := src;   { "Remember this" }
  244.          New(src);                { allocate mem. for a new rec }
  245.       END
  246.       ELSE { process a has-parent long; never goes in separate file }
  247.       BEGIN
  248.          { locate parent in list }
  249.          sra := sr1;
  250.          WHILE (sra^.file_offs <> par_dw) AND (sra <> NIL) DO
  251.             sra := sra^.next;
  252.          IF sra^.file_offs = par_dw THEN
  253.          BEGIN               { change ptrs }
  254.             IF sra^.first_ptr = -1 THEN
  255.                BEGIN
  256.                   sra^.first_ptr := last_read_pos;
  257.                   sra^.last_ptr  := last_read_pos;
  258.                END
  259.             ELSE BEGIN            { it's safe to assume an interval }
  260.                IF sra^.first_ptr > last_read_pos
  261.                   THEN sra^.first_ptr := last_read_pos;
  262.                IF sra^.last_ptr < last_read_pos
  263.                   THEN sra^.last_ptr := last_read_pos;
  264.             END;
  265.          END
  266.          ELSE
  267.             WRITELN(reptf,'WARNING: Parent not found ',hexDW(last_read_pos));
  268.             { linker must have caught this (?) }
  269.       END; { if }
  270.       Inc(cnt);
  271.       IF cnt MOD  10 = 0 THEN WRITE(screen,'.');       { simple odometer }
  272.       IF cnt MOD 500 = 0 THEN WRITELN(screen);
  273.    UNTIL Eof(NGf);
  274.    WRITELN(screen);
  275. END;  { register_strucs }
  276.  
  277.  
  278. PROCEDURE list_statistics(VAR f : TEXT);
  279. BEGIN
  280.    WRITELN(f, in_name);
  281.    WRITELN(f, NG_name);
  282.    WRITELN(f);
  283.    WRITELN(f, 'File size: ',hexDW(file_size),'  (',file_size,'d)');
  284.    WRITELN(f,no_of_menus : 8, ' menus');
  285.    WRITELN(f,no_of_shorts: 8, ' short strucs');
  286.    WRITELN(f,no_of_longs : 8, ' long strucs');
  287.    WRITELN(f,' --> ',out_files_num : 3,' files.');
  288.    WRITELN(f);
  289. END;
  290.  
  291.  
  292. PROCEDURE list_pointers(VAR f : TEXT);
  293. { Display list of pointers }
  294. VAR sra : struc_rec_ptr;
  295. BEGIN
  296.    sra := sr1;
  297.    WRITELN(f);
  298.    WRITELN(f,'Numbers in hex, except target file #');
  299.    WRITELN(f);
  300.    WRITELN(f,'ID    FileOffs  1stptr    Lastptr   Tgt  Parent');
  301.    WHILE sra <> NIL DO BEGIN
  302.       WRITE(f,hexw(sra^.ID),'  ',hexdw(sra^.file_offs),'  ');
  303.       WRITE(f,hexdw(sra^.first_ptr),'  ',hexdw(sra^.last_ptr),'  ');
  304.       WRITELN(f,zeropad(sra^.tgt_file),'  ',hexdw(sra^.par_ptr));
  305.       sra := sra^.next;
  306.    END;
  307.    WRITELN(f);
  308. END;
  309.  
  310.  
  311. FUNCTION lookup_file_no(fp : DWORD) : WORD;
  312. { Look up struc offset in pointer table,
  313.   and return the corresponding output file number }
  314. VAR sra : struc_rec_ptr;
  315. BEGIN
  316.    sra := sr1;
  317.    WHILE (sra^.file_offs <> fp) AND (sra <> NIL) DO
  318.       sra := sra^.next;
  319.    IF sra^.file_offs = fp
  320.       THEN lookup_file_no := sra^.tgt_file
  321.       ELSE lookup_file_no := 999;   
  322. END;
  323.  
  324.  
  325. FUNCTION lookup_sa_ref(fp : DWORD) : WORD;
  326. { Look up seealso reference in pointer table,
  327.   and return the corresponding output file number,
  328.   returns 999 if not found }
  329. VAR sra : struc_rec_ptr; found : BOOLEAN;
  330. BEGIN
  331.    sra := sr1;  found := False;
  332.    WHILE NOT found AND (sra <> NIL) DO
  333.       IF (fp >= sra^.first_ptr) AND (fp <= sra^.last_ptr)
  334.          THEN found := True
  335.       ELSE sra := sra^.next;
  336.    IF found THEN lookup_sa_ref := sra^.tgt_file
  337.    ELSE lookup_sa_ref := 999;       { not found; NGML only warns about this }
  338. END;
  339.  
  340.  
  341. PROCEDURE process_long_struc(VAR f : TEXT; curr_file:WORD; lookup:BOOLEAN);
  342. { Process long in var buf }
  343. VAR lines,ix,j,k,len,sa_offs,sa_no : WORD;
  344. BEGIN
  345.    ix := fixed_struc_size;
  346.    lines := getW(4);
  347.    FOR j := 0 TO Pred(lines) DO                 { no. of lines }
  348.       BEGIN
  349.          WRITELN(f, getNGstr(ix,len));
  350.          ix := ix + Succ(len);                  { bump trailing zero }
  351.       END;
  352.  
  353.    { process SeeAlso data, if appropriate }
  354.    IF NOT lookup OR (getW(6) = 0) THEN EXIT;
  355.    sa_offs := fixed_struc_size + getW(6);
  356.    sa_no := getW(sa_offs);
  357.    IF sa_no = 0 THEN EXIT;
  358.    WRITE(f,'!Seealso:');
  359.    ix := sa_offs + 2 + sa_no * 4;               { index of 1st string }
  360.    FOR j := 0 TO Pred(sa_no) DO
  361.       BEGIN
  362.          k := lookup_sa_ref(getDW(sa_offs + 2 + j * 4));
  363.          IF k <> curr_file THEN                 { put file ref. in }
  364.             BEGIN
  365.                WRITE(f, fprefix + zeropad(k) + dot_NGO + ':');
  366.                IF k = 999 THEN                  { put warning in report }
  367.                   WRITELN(reptf,'Unresolved S/A (file: '
  368.                           + zeropad(curr_file) + ')');
  369.             END;
  370.          WRITE(f, '"' + getNGstr(ix, len)  + '"  ');
  371.          ix := ix + Succ(len);
  372.       END;
  373.    WRITELN(f);
  374. END;  { process_long_struc }
  375.  
  376.  
  377. PROCEDURE process_struc(VAR datf:TEXT;
  378.           fpos:DWORD; file_no:WORD; lookup:BOOLEAN);
  379. { Process long OR short struc incl. longs/shorts in next level,
  380.   and display a simple odometer }
  381. VAR it,i,len,num,itc : WORD;  srt : struc_rec_ptr;
  382.     caption : str100; entry_pos : DWORD;
  383. BEGIN
  384.    WRITELN(screen,'File : '+ fprefix + zeropad(file_no) + dot_ASC);
  385.    Seek(NGf, fpos);
  386.    read_n_decrypt_struc(last_ID, True);
  387.    IF last_ID > menu_ID THEN exZit(12);         { unknown ID }
  388.    {}
  389.    IF last_ID = long_ID THEN                    { long off menu }
  390.       BEGIN
  391.          WRITELN(screen,'l');
  392.          process_long_struc(datf, file_no, lookup);
  393.          EXIT;  { done here }
  394.       END;
  395.  
  396.    { beyond this point: current struc is short }
  397.    it := getW(4);                               { no. of items to process }
  398.    Move(buf, sbuf, fixed_struc_size + getW(2)); { copy to VAR sbuf while
  399.                                                   processing next level }
  400.  
  401.    FOR itc := 0 TO Pred(it) DO
  402.       BEGIN
  403.          caption := getNGstr_s($1A + getW_s($1A + itc * 6), len);
  404.          entry_pos := getDW_s($1A + 2 + itc * 6);
  405.          WRITELN(datf, '!Short:' + caption);
  406.          IF entry_pos = -1 THEN    { done here:  no entry, just a caption }
  407.          ELSE IF lookup_file_no(entry_pos) = 999 THEN
  408.             BEGIN       { expands into long }
  409.               IF itc = 0 THEN WRITE(screen,'s');
  410.               WRITE(screen,'l');
  411.               Seek(NGf, entry_pos);
  412.               read_n_decrypt_struc(last_ID, True);
  413.               process_long_struc(datf, file_no, lookup)
  414.             END
  415.          ELSE           { expands into short }
  416.             BEGIN
  417.                srt := sr1;        { register caption in struc record }
  418.                WHILE (srt^.tgt_file <> lookup_file_no(entry_pos))
  419.                   AND (srt <> NIL) DO srt := srt^.next;
  420.                IF srt^.tgt_file = lookup_file_no(entry_pos)
  421.                   THEN srt^.txt := caption
  422.                   ELSE srt^.txt := '';
  423.                WRITE(screen,'f');
  424.                WRITELN(datf, '!File:'
  425.                  + fprefix + zeropad(lookup_file_no(entry_pos)) + dot_NGO);
  426.             END;
  427.       END;  { FOR }
  428.  
  429.       WRITELN(screen);
  430. END;  { process_struc }
  431.  
  432.  
  433. { MAIN -------------------------------------------------------------------- }
  434.  
  435. VAR
  436.    { general purpose vars }
  437.    i,j      : WORD;
  438.    this_num : WORD;
  439.    this_pos : DWORD;
  440.  
  441. BEGIN
  442.    { Get args from command line }
  443.    parse_command(rc, in_name);
  444.    IF is_info_req THEN exZit(1);
  445.    IF rc > 0 THEN exZit(2);
  446.    IF is_rept_only THEN is_partial := False;
  447.  
  448.    ASSIGN(NGf, in_name);
  449.    FileMode := 0;                    { open as read-only }
  450.    {$I-}  RESET(NGf, 1);  {$I+}
  451.    IF IOresult <> 0 THEN exZit(4);   { error on input }
  452.    file_size := FileSize(NGf);
  453.  
  454.  
  455.    { Init vars }
  456.    no_of_shorts  := 0;
  457.    no_of_longs   := 0;
  458.    out_files_num := 0;               { count is one-based }
  459.  
  460.    fprefix       := '____';
  461.    i := Length(in_name);  j := 1;
  462.    WHILE (i > 1) AND NOT (in_name[Pred(i)] IN [':','\']) DO
  463.       Dec(i);
  464.    WHILE (in_name[i] <> '.') AND (j <= 4) DO
  465.       BEGIN fprefix[j] := in_name[i]; Inc(i); Inc(j); END;
  466.  
  467.  
  468.    ASSIGN(screen,'CON');
  469.    IF is_quiet THEN ASSIGN(screen,'NUL');
  470.    REWRITE(screen);
  471.  
  472.  
  473.    { Process /P switch bypassing all indexing }
  474.    IF is_partial THEN BEGIN
  475.       sr1 := NIL;
  476.       ASSIGN(datf, fprefix + zeropad(_112) + dot_ASC);
  477.       SetTextBuf(datf, textbuffer);
  478.       REWRITE(datf);
  479.       process_struc(datf, partial_offs, _112, False);
  480.       CLOSE(datf);
  481.       exZit(0);                                 { ------------- }
  482.    END;
  483.  
  484.  
  485.    FindFirst(fprefix + '*.*', Archive, dir_info);
  486.    IF (DosError = 0) AND (Pos(dot_NG,dir_info.Name) = 0) THEN BEGIN
  487.       WRITELN(screen,'* WARNING *');
  488.       WRITELN(screen,'Current directory has files matching ',fprefix + '*.*');
  489.       WRITELN(screen,'Press Break (Ctrl-C) NOW to avoid overwriting files.');
  490.       WRITELN(screen);
  491.    END;
  492.  
  493.  
  494.    IF is_rept_only THEN
  495.       WRITELN(screen,'Report only');
  496.    ASSIGN(reptf, fprefix + dot_RPT);
  497.    REWRITE(reptf);                              { open report file }
  498.  
  499.    read_n_verify_header;                        { first read the header }
  500.    curr_menu := 0;
  501.    REPEAT                                       { then the menus }
  502.       read_n_decrypt_struc(last_ID, True);
  503.       IF last_ID = menu_ID THEN BEGIN
  504.          get_menu_struc;
  505.          Inc(curr_menu);
  506.       END;
  507.    UNTIL (curr_menu = no_of_menus)
  508.          OR (last_ID <> menu_ID) OR Eof(NGf);
  509.    IF curr_menu <> no_of_menus THEN exZit(9);   { menu number mismatch }
  510.    IF last_ID > menu_ID THEN exZit(12);         { abort if unknown ID }
  511.  
  512.  
  513.    { Register strucs in single-linked pointer list }
  514.    src := NIL;
  515.    Mark(srm);                 { record the heap state }
  516.    New(src);
  517.    sr1 := src;                { pointer to 1st rec }
  518.    register_strucs;           { read rest of file }
  519.    { at this point, sr1 points to 1st rec,
  520.      srp points to last rec (srp^.next = NIL) }
  521.  
  522.  
  523.    { Show list of pointers/statistics }
  524.    list_statistics(screen);
  525.    (*   list_pointers(screen); *)
  526.  
  527.  
  528.    { Write the data files }
  529.    sra := sr1;
  530.    WHILE sra <> NIL DO
  531.       BEGIN
  532.          ASSIGN(datf, fprefix + zeropad(sra^.tgt_file) + dot_ASC);
  533.          IF is_rept_only THEN ASSIGN(datf,'NUL');
  534.          SetTextBuf(datf, textbuffer);      { 8 K buffer for fast writes }
  535.          REWRITE(datf);
  536.          process_struc(datf, sra^.file_offs, sra^.tgt_file, True);
  537.          CLOSE(datf);
  538.          sra := sra^.next;
  539.       END;
  540.  
  541.  
  542.    { Synchronize menu info and pointer list (file no. and texts) }
  543.    FOR curr_menu := 0 TO Pred(no_of_menus) DO
  544.       FOR curr_item := 0 TO Pred(menu[curr_menu].items) DO
  545.          BEGIN
  546.             this_pos := menu[curr_menu].drop[curr_item].fptr;
  547.             this_num := lookup_file_no(this_pos);
  548.             menu[curr_menu].drop[curr_item].datn := this_num;
  549.             sra := sr1;
  550.             WHILE (sra^.tgt_file <> this_num) AND (sra <> NIL) DO
  551.                sra := sra^.next;
  552.             IF sra^.tgt_file = this_num THEN
  553.                sra^.txt := Copy(menu[curr_menu].toptxt,1,8) + ': '
  554.                            + menu[curr_menu].drop[curr_item].txt;
  555.          END;
  556.  
  557.  
  558.    WRITELN(screen,'Writing report file');
  559.    list_statistics(reptf);
  560.    list_pointers(reptf);
  561.    sra := sr1;
  562.    WHILE sra <> NIL DO                          { list menus/captions }
  563.       BEGIN
  564.          WRITELN(reptf,
  565.             fprefix+zeropad(sra^.tgt_file) + dot_ASC + ': ', sra^.txt);
  566.          sra := sra^.next;
  567.       END;
  568.    CLOSE(reptf);
  569.    IF NOT is_rept_only THEN BEGIN
  570.       WRITELN(screen,'Writing link and make files');
  571.       write_link_file;
  572.       write_make_file;
  573.    END;
  574.  
  575.  
  576.    Release(srm);        { return heap to previous state }
  577.    exZit(0);            { all termination is routed through proc. exZit }
  578. END.
  579.  
  580.